home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / RTTI / TestForm.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-04-12  |  4.5 KB  |  191 lines
  1. unit TestForm;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, PropertyIO;
  8.  
  9. type
  10.   TSex = (sxUnknown, sxMale, sxFemale);
  11.   TPet = (Dog, Cat, Rabbit, Hamster);
  12.   TPets = set of TPet;
  13.  
  14.   TPerson = class (TSQLObject)
  15.   private
  16.     FName: String;
  17.     FAge: Integer;
  18.     FSex: TSex;
  19.     FPets: TPets;
  20.     function GetPets: String;
  21.     procedure SetPets (Value: String);
  22.   published
  23.     // properties with RTTI follow
  24.     property Name: String read FName write FName;
  25.     property Age: Integer read FAge write FAge;
  26.     property Sex: TSex read FSex write FSex;
  27.     property Pets: TPets read FPets write FPets stored False;
  28.     property PetStr: String read GetPets write SetPets;
  29.   end;
  30.  
  31.   TForm1 = class(TForm)
  32.     btnExport: TButton;
  33.     btnImport: TButton;
  34.     pioImporter: TPropertyImporter;
  35.     pioExporter: TPropertyExporter;
  36.     btnExit: TButton;
  37.     edtName: TEdit;
  38.     edtAge: TEdit;
  39.     cboSex: TComboBox;
  40.     lblName: TLabel;
  41.     lblAge: TLabel;
  42.     lblSex: TLabel;
  43.     btnSQLInsert: TButton;
  44.     btnSQLUpdate: TButton;
  45.     btnSQLSelect: TButton;
  46.     grpPets: TGroupBox;
  47.     chkDog: TCheckBox;
  48.     chkCat: TCheckBox;
  49.     chkRabbit: TCheckBox;
  50.     chkHamster: TCheckBox;
  51.     procedure btnExportClick(Sender: TObject);
  52.     procedure btnImportClick(Sender: TObject);
  53.     procedure pioImporterObjectImported(Sender: TObject);
  54.     procedure btnExitClick(Sender: TObject);
  55.     procedure FormShow(Sender: TObject);
  56.     procedure btnSQLInsertClick(Sender: TObject);
  57.     procedure btnSQLUpdateClick(Sender: TObject);
  58.     procedure btnSQLSelectClick(Sender: TObject);
  59.     procedure FormCreate(Sender: TObject);
  60.     procedure FormDeactivate(Sender: TObject);
  61.   private
  62.     Person: TPerson;
  63.     procedure PopulatePerson;
  64.   public
  65.   end;
  66.  
  67. var
  68.   Form1: TForm1;
  69.  
  70. implementation
  71.  
  72. uses
  73.   TypInfo;
  74.  
  75. {$R *.DFM}
  76.  
  77. // TPerson
  78.  
  79. function TPerson.GetPets: String;
  80. begin
  81.   Result := '';
  82.   if Dog in Pets then Result := Result + 'D';
  83.   if Cat in Pets then Result := Result + 'C';
  84.   if Rabbit in Pets then Result := Result + 'R';
  85.   if Hamster in Pets then Result := Result + 'H';
  86. end;
  87.  
  88. procedure TPerson.SetPets (Value: String);
  89. begin
  90.   FPets := [];
  91.   if Pos ('D', Value) <> 0 then FPets := FPets + [Dog];
  92.   if Pos ('C', Value) <> 0 then FPets := FPets + [Cat];
  93.   if Pos ('R', Value) <> 0 then FPets := FPets + [Rabbit];
  94.   if Pos ('H', Value) <> 0 then FPets := FPets + [Hamster];
  95. end;
  96.  
  97. // TForm1
  98.  
  99. procedure TForm1.PopulatePerson;
  100. begin
  101.   // name
  102.   Person.Name := edtName.Text;
  103.   // age
  104.   try
  105.     Person.Age := StrToInt (edtAge.Text);
  106.   except
  107.     on EConvertError do begin
  108.       Person.Age := 0;
  109.     end;
  110.   end;
  111.   // sex
  112.   if cboSex.ItemIndex <> -1 then begin
  113.     Person.Sex := TSex (cboSex.ItemIndex);
  114.   end;
  115.   // pets
  116.   Person.Pets := [];
  117.   if chkDog.Checked then Person.Pets := Person.Pets + [Dog];
  118.   if chkCat.Checked then Person.Pets := Person.Pets + [Cat];
  119.   if chkRabbit.Checked then Person.Pets := Person.Pets + [Rabbit];
  120.   if chkHamster.Checked then Person.Pets := Person.Pets + [Hamster];
  121. end;
  122.  
  123. procedure TForm1.btnExportClick(Sender: TObject);
  124. begin
  125.   PopulatePerson;
  126.   // write out the object
  127.   pioExporter.ExportObject (Person);
  128. end;
  129.  
  130. procedure TForm1.btnImportClick(Sender: TObject);
  131. begin
  132.   RegisterClass (TPerson);
  133.  
  134.   pioImporter.ImportFile (pioExporter.FileName);
  135. end;
  136.  
  137. procedure TForm1.pioImporterObjectImported(Sender: TObject);
  138. begin
  139.   if Sender is TPerson then begin
  140.     with Sender as TPerson do begin
  141.       edtName.Text := Name;
  142.       edtAge.Text := IntToStr (Age);
  143.       cboSex.ItemIndex := Ord (Sex);
  144.       chkDog.Checked := (Dog in Pets);
  145.       chkCat.Checked := (Cat in Pets);
  146.       chkRabbit.Checked := (Rabbit in Pets);
  147.       chkHamster.Checked := (Hamster in Pets);
  148.     end;
  149.   end;
  150. end;
  151.  
  152. procedure TForm1.btnExitClick(Sender: TObject);
  153. begin
  154.   Application.Terminate;
  155. end;
  156.  
  157. procedure TForm1.FormShow(Sender: TObject);
  158. begin
  159.   cboSex.ItemIndex := 0;
  160. end;
  161.  
  162. procedure TForm1.btnSQLInsertClick(Sender: TObject);
  163. begin
  164.   PopulatePerson;
  165.   ShowMessage (Person.SQLInsert)
  166. end;
  167.  
  168. procedure TForm1.btnSQLUpdateClick(Sender: TObject);
  169. begin
  170.   PopulatePerson;
  171.   ShowMessage (Person.SQLUpdate)
  172. end;
  173.  
  174. procedure TForm1.btnSQLSelectClick(Sender: TObject);
  175. begin
  176.   PopulatePerson;
  177.   ShowMessage (Person.SQLSelect)
  178. end;
  179.  
  180. procedure TForm1.FormCreate(Sender: TObject);
  181. begin
  182.   Person := TPerson.Create;
  183. end;
  184.  
  185. procedure TForm1.FormDeactivate(Sender: TObject);
  186. begin
  187.   Person.Free;
  188. end;
  189.  
  190. end.
  191.